home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Packages / Docprojects.tcl < prev    next >
Encoding:
Text File  |  1998-12-16  |  32.6 KB  |  1,031 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  Vince's Additions - an extension package for Alpha
  4.  # 
  5.  #  FILE: "Docprojects.tcl"
  6.  #                                    created: 29/7/97 {4:59:22 pm} 
  7.  #                                last update: 16/12/1998 {1:42:07 pm} 
  8.  #  Author: Vince Darley
  9.  #  E-mail: <darley@fas.harvard.edu>
  10.  #    mail: Division of Engineering and Applied Sciences, Harvard University
  11.  #          Oxford Street, Cambridge MA 02138, USA
  12.  #     www: <http://www.fas.harvard.edu/~darley/>
  13.  #  
  14.  # Copyright (c) 1997-1998  Vince Darley, all rights reserved
  15.  # 
  16.  # See the file "license.terms" for information on usage and redistribution
  17.  # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  18.  # ###################################################################
  19.  ##
  20.  
  21. alpha::extension documentProjects 1.6.2 {
  22.     set alpha::prefs(documentProjects) Docproj
  23.     alpha::package require -loose Alpha 7.1p3
  24.     namespace eval Docproj {}
  25.     # dummy value
  26.     ensureset docProject(name) [list "None" "Project2" "Thesis"]
  27.     # The name of the current project.  Every project has a unique name
  28.     newPref var currentProject "None" Docproj "" docProject(name) "varitem"
  29.     # Different identities can be useful if your projects may be sometimes
  30.     # for work purposes, sometimes for your own purposes etc.
  31.     newPref var identity Usual Docproj Docproj::changeIdentity identities "array"
  32.     menu::buildProc "Current Project" \
  33.       {menu::buildFlagMenu "Current Project" list currentProject DocprojmodeVars}
  34.     menu::insert packagePrefs submenu 0 {Current Project}
  35.     menu::insert packagePrefs items 0 \
  36.       "documentProjectPrefs…" "userDetails…" \
  37.       "<E<SremoveDocumentTemplate…" "<S<BeditDocumentTemplate…" \
  38.       "<SnewDocumentTemplate…" \
  39.       "<E<SremoveProject…" "<S<BeditProject…" "<SnewProject…"
  40.     # Key-binding to update the version number in a file's header.
  41.     # These version numbers can be inserted by some of the standard
  42.     # document templates.
  43.     newPref binding updateFileVersion "/f<U" Docproj
  44.     menu::insert winUtils items end \
  45.         "updateDate" \
  46.         "[menu::bind DocprojmodeVars(updateFileVersion) -]"
  47.     lunion elec::MenuTemplates "createHeader" "newDocument"
  48.     catch "unBind F1 bind::Completion"
  49.     menu::insert elec items end \
  50.         {Menu -n FunctionComments -p menu::generalProc {
  51.         "/eusual"    
  52.         "/e<Isimple" 
  53.         "/e<OwithAuthor" 
  54.         "/e<Uupdate" 
  55.     }}
  56.     namespace eval newDocument {}
  57.     set "newDocument::handlers(Document Projects)" Docproj::newHandler
  58.     # Use this simple proc if we don't have the newDocument package.
  59.     if {![alpha::package exists newDocument]} {
  60.         ;proc file::newDocument {} {
  61.             beep
  62.             Docproj::newHandler [list -n [statusPrompt "New doc name:"]]
  63.         }
  64.     } else {
  65.         alpha::package require newDocument
  66.     }
  67.     
  68.     # When you request a new document, if this flag is set the user
  69.     # is only prompted with a list of document templates which 
  70.     # are relevant to the current mode.  This can be useful if you 
  71.     # have lots of templates.
  72.     newPref flag docTemplatesModeSpecific 1 Docproj
  73.     # When a file is saved, its header (time-stamp) etc can be
  74.     # automatically updated.
  75.     newPref flag autoUpdateHeader 1 Docproj
  76.     # call on saveHook
  77.     proc Docproj::changeProject {name} {
  78.         if {$name == "*"} { return }
  79.         menu::flagProc "Current Project" $name
  80.     }
  81.     
  82.     # call on saveHook
  83.     hook::register saveHook updateHeaderHook
  84. } maintainer {
  85.     "Vince Darley" darley@fas.harvard.edu <http://www.fas.harvard.edu/~darley/>
  86. } uninstall {this-file} help {file "Documentprojects Help"}
  87.  
  88. # user projects
  89. if ![info exists docProject(addendum)] {
  90.     set docProject(addendum) { {none} {about some other stuff} {deep problems}}
  91.     set docProject(default_modes) { {} {C++ Tcl} {TeX}}
  92.     set docProject(extra) [list "" "Freely distributable" "Copyright (C) 1997-1998 the author."]
  93.     set docProject(license) [list "" "" ""]
  94. }
  95.  
  96.  
  97. proc updateHeaderHook {name} {
  98.     global DocprojmodeVars
  99.     if $DocprojmodeVars(autoUpdateHeader) {
  100.     # update does no harm if it fails so we call it for all
  101.     # modes with no worries.
  102.     getWinInfo -w $name a
  103.     if {$a(dirty)} {
  104.         file::updateDate $name
  105.     }
  106.     }
  107. }
  108.  
  109. # header/source templates (NOTE: FORMAT OF THIS LIST MAY CHANGE)
  110. llunion elec::DocTemplates 1 \
  111.     { * "Empty" * "" *} \
  112.     { * "Default" * t_default *} \
  113.     { TeX "Basic LaTeX document" "None" t_latex * {article report letter book slides}} \
  114.     { C++ "Basic C++ header file" "Header" t_cpp_header * } \
  115.     { C++ "Basic C++ source file" "Source" t_cpp_source * } \
  116.     { HTML "HTML document" * t_html * } 
  117.     ## 
  118.      # \
  119.      # { C++ "Cpptcl Class Source" Source t_cpptcl_source "Cpptcl"} \
  120.      # { C++ "Cpptcl Class Header" Header t_cpptcl_header "Cpptcl"} \
  121.      # { Tcl "Itcl Class" * t_itcl_class "Cpptcl"}  \
  122.      # { Tcl "Blank Tcl Header" Header "\#" "Vince's Additions"} \
  123.      # { C++ "EvoX Class Source" Source t_cpptcl_source "EvoX"} \
  124.      # { C++ "EvoX Class Header" Header t_cpptcl_header "EvoX"}
  125.      ##
  126.  
  127. # used for file description headers
  128. if $synchroniseWithInternetConfig {
  129.     catch {set user(author) [icGetPref RealName]}
  130.     catch {set user(email) "<[icGetPref Email]>"}
  131.     catch {set user(www) "<[icGetPref WWWHomePage]>"}
  132.     catch {set user(organisation) [icGetPref Organization]}
  133. } 
  134. ensureset user(author) "Ken McKen"
  135. ensureset user(email) "ken@kenny.com"
  136. ensureset user(www) "http://www.kenny.com/"
  137. ensureset user(organisation) "Ken Corp."
  138.  
  139. ensureset user(address) "Rose St, MA 02143, USA"
  140. ensureset user(author_initials) "VMD"
  141.  
  142. ensureset identities(Usual) [array get user]
  143.  
  144. proc Docproj::changeIdentity {var} {
  145.     global identities user DocprojmodeVars
  146.     array set user $identities($DocprojmodeVars($var))
  147. }
  148.  
  149. if {[info exists DocprojmodeVars(identity)]} {
  150.     Docproj::changeIdentity identity
  151. }
  152.  
  153. ## 
  154.  # ###################################################################
  155.  #    Used to be "docProjEngine.tcl", now one file:
  156.  # ###################################################################
  157.  ##
  158.  
  159. proc global::userDetails {} {
  160.     global DocprojmodeVars modifiedArrayElements user identities
  161.     dialog::pkg_options "Docprojects" \
  162.       "User Details (some may be from Internet Config)" 1 user
  163.     if {![dialog::yesno -y "Update" -n "New Identity" \
  164.       "Update $DocprojmodeVars(identity) identity, or make a new one?"]} {
  165.     # Ask for new name
  166.     set name [eval prompt [list "Enter tag for new identity" \
  167.       "<Tag>" "Old ids:"] [array names identities]]
  168.     set identities($name) [array get user]
  169.     set DocprojmodeVars(identity) $name
  170.     # Have to store Usual id too.
  171.     lappend modifiedArrayElements [list $name identities] \
  172.       [list identity DocprojmodeVars] [list Usual identities]
  173.     }
  174. }
  175.  
  176. proc global::documentProjectPrefs {} {
  177.     dialog::pkg_options "Docproj" "Preferences for your Document Projects"
  178. }
  179.  
  180. proc Docproj::newHandler {args} {
  181.     set doc [file::createDocument "new $args"]
  182.     if {[getModifiers] & 72} {
  183.     file::pickProject
  184.     }
  185.     file::createHeader $doc
  186.     return ""
  187. }
  188.  
  189. proc file::pickProject {} {
  190.     global DocprojmodeVars docProject
  191.     set item [listpick -p "Pick a project…" -L $DocprojmodeVars(currentProject) \
  192.       $docProject(name)]
  193.     if {$item != ""} {Docproj::changeProject $item }
  194.     return $item
  195. }
  196.  
  197. proc file::projectName {} { 
  198.     global DocprojmodeVars
  199.     return $DocprojmodeVars(currentProject)
  200. }
  201.  
  202. proc file::projectAddendum {} {
  203.     global docProject DocprojmodeVars
  204.     return [lindex $docProject(addendum) \
  205.       [lsearch -exact $docProject(name) $DocprojmodeVars(currentProject)]]
  206. }
  207.  
  208. proc file::projectExtra {} {
  209.     global docProject DocprojmodeVars
  210.     return [lindex $docProject(extra) \
  211.       [lsearch -exact $docProject(name) $DocprojmodeVars(currentProject)]]
  212. }
  213. proc file::projectLicense {} {
  214.     global docProject DocprojmodeVars
  215.     set ret [lindex $docProject(license) \
  216.       [lsearch -exact $docProject(name) $DocprojmodeVars(currentProject)]]
  217.     if {$ret == ""} {
  218.     return "none"
  219.     } else {
  220.     return $ret
  221.     }
  222. }
  223.  
  224. namespace eval functioncomments {}
  225.  
  226. ## 
  227.  # ----------------------------------------------------------------------
  228.  #     
  229.  #    "file::functionComment" --
  230.  #    
  231.  #     This procedure    generates a    nice little    comment    box
  232.  #     like this one here.
  233.  #    
  234.  #    Results:
  235.  #     Well it doesn't return    anything, but it allows    you    to
  236.  #     enter each    item simply, moving    from one to the next with Tab
  237.  #    
  238.  #    Side effects:
  239.  #     Not much
  240.  #    
  241.  # ----------------------------------------------------------------------
  242.  ##
  243. proc functioncomments::usual { {simple ""} {author 0} } {
  244.     global user
  245.     set fn [getSelect]
  246.     set fn [lindex $fn end]
  247.     beginningOfLine
  248.     set t "-------------------------------------------------------------------------\r"
  249.     append t "\r"
  250.     append t "\"$fn\" --\r"
  251.     append t "\r •description•\r"
  252.     if { $simple != "simple" } {
  253.     append t "\rResults:\r •results•\r\rSide effects:\r •side effects•\r"
  254.     }
  255.     if $author {
  256.     append t "\r--Version--Author------------------Changes-------------------------------"
  257.     append t "\r   1.0     $user(email) original\r"
  258.     }
  259.     append t "-------------------------------------------------------------------------"
  260.     set t [file::commentTextBlock $t]
  261.     elec::CenterInsertion $t
  262. }
  263.  
  264. proc functioncomments::simple {} { return [functioncomments::usual simple 0]}
  265. proc functioncomments::withAuthor {} { return [functioncomments::usual "" 1] }
  266.  
  267. proc file::commentTextBlock {text} {
  268.     set cc [commentCharacters "Paragraph"]
  269.     set c [lindex $cc 2]
  270.     regsub -all "\[\r\n\]" $text "\r${c}" text
  271.     return "[lindex $cc 0]\r[lindex $cc 2]${text}\r[lindex $cc 1]\r"
  272. }
  273.  
  274. ## 
  275.  # -------------------------------------------------------------------------
  276.  #     
  277.  #    "file::functionCommentUpdate" --
  278.  #    
  279.  #     Handles updating of a version line    like the one below
  280.  #    
  281.  # --Version--Author------------------Changes-------------------------------  
  282.  #      1.0      <darley@fas.harvard.edu> original
  283.  #    1.1     <darley@fas.harvard.edu> quickly updated with shift-F1
  284.  # -------------------------------------------------------------------------
  285.  ##
  286. proc functioncomments::update {} {
  287.     global user
  288.     set begin [lindex [commentCharacters Paragraph] 2]
  289.     goto [file::findLocally "${begin}--Version--Author"]
  290.     goto [nextLineStart [nextLineStart [getPos] ]]
  291.     goto [file::findLocally "${begin}-------"]
  292.     elec::Insertion "${begin}   •Version•     $user(email) •Changes•\r"
  293. }
  294.  
  295. ## 
  296.  # -------------------------------------------------------------------------
  297.  #     
  298.  #    "file::findLocally" --
  299.  #    
  300.  #     Looks around for a    particular sequence    of characters (or a    regexp)
  301.  #     and returns the start of the closest fit, either fowards or backwards,
  302.  #     or    "" if no match was found.
  303.  # -------------------------------------------------------------------------
  304.  ##
  305. proc file::findLocally { chars {regexp 0} { pos "" } } {
  306.     if { $pos == "" } { set pos [getPos] }
  307.     
  308.     set found1 [lindex [search -s -f 0 -n -r $regexp -- "$chars" $pos] 0]
  309.     set found2 [lindex [search -s -f 1 -n -r $regexp -- "$chars" $pos] 0]
  310.     
  311.     if { $found1 != "" && $found2 != "" } { 
  312.     if [expr ([pos::math $pos + 0] - [pos::math $found1 + 0]) \
  313.       <= ([pos::math $found2 + 0] - [pos::math $pos + 0]) ] {
  314.         return $found1
  315.     } else {
  316.         return $found2
  317.     }
  318.     }
  319.     
  320.     # return whatever we can, possibly ""
  321.     if { $found1 != "" } {
  322.     return $found1
  323.     } else {
  324.     if { $found2 == "" } { 
  325.         message "Couldn't find: $chars"
  326.     }
  327.     return $found2
  328.     }
  329. }
  330.  
  331.  
  332. ## 
  333.  # -------------------------------------------------------------------------
  334.  #     
  335.  #    "file::updateFileVersion"    --
  336.  #    
  337.  #     Update    the    version    number and information in the header block
  338.  #     of    a file.  Copes with both my old and new formats.
  339.  #    
  340.  # -------------------------------------------------------------------------
  341.  ##
  342. proc file::updateFileVersion {} {
  343.     global user
  344.     # in case the user wishes to return quickly
  345.     pushPosition
  346.     
  347.     goto [minPos]
  348.     set begin [lindex [commentCharacters Paragraph] 2]
  349.     set pos [file::findLocally "_/_/_" 0]
  350.     if { $pos == "" || [pos::compare $pos > [pos::math [minPos] + 1000]]} {
  351.     set srch [quote::WhitespaceReg [quote::Regfind "${begin} " ]]
  352.     append srch {[0-9]+/[0-9]+/[0-9]+}
  353.     set pos [file::findLocally $srch 1]
  354.     if { $pos == "" } {
  355.         message "Couldn't find original version template."
  356.         set srch [quote::Regfind "${begin} "]
  357.         append srch "See header file for further information"
  358.         set pos [file::findLocally [quote::WhitespaceReg $srch]]
  359.         if { $pos != "" } {
  360.         set pos [nextLineStart $pos]
  361.         } else {
  362.         goto [minPos]
  363.         set pos [file::findLocally "${begin}\#\#\#"]
  364.         if { $pos == "" } { message "Couldn't find any header" ; return }
  365.         set pos [lindex [search -s -f 1 -n -- "${begin}\#\#\#" [nextLineStart $pos]] 0]
  366.         if { $pos == "" } { message "Couldn't find any header" ; return }
  367.         }
  368.         goto $pos
  369.         set t  "${begin}\r"
  370.         append t  "${begin} modified by  rev reason\r"
  371.         append t  "${begin} ---------- --- --- -----------\r"
  372.         append t  "${begin} [file::paddedDate] $user(author_initials) 1.0 original\r"
  373.         insertText $t
  374.         select $pos [getPos]
  375.         return ""
  376.     } else {
  377.         # This is the normal case.
  378.         # Find the last version number
  379.         set p [minPos]
  380.         while {[pos::compare $p != $pos]} {
  381.         set pos $p
  382.         set p [file::findLocally $srch 1 [nextLineStart $p] ]
  383.         }
  384.         set pos [nextLineStart $pos]
  385.     }    
  386.     } else {
  387.     # old style header
  388.     set pos [lineStart $pos]
  389.     replaceText $pos [nextLineStart $pos] ""
  390.     }
  391.     # Now pos is at the start of the line where we wish to insert
  392.     goto $pos
  393.     elec::Insertion "${begin} [file::paddedDate] $user(author_initials) •• ••\r"
  394.     message "Pop position to return to where you were."
  395.     return ""
  396. }
  397.  
  398. proc file::paddedDate {{when ""}} {
  399.     if {$when == ""} { set when [now] }
  400.     return [string range "[lindex [mtime $when short] 0]     " 0 9]
  401. }
  402.  
  403. proc file::created {{convert 1}} {
  404.     if [catch {getFileInfo [win::Current] info}] {
  405.     if $convert {
  406.         return [mtime [now]]
  407.     } else {
  408.         return [now]
  409.     }
  410.     } else {
  411.     if $convert {
  412.         return [mtime $info(created)]
  413.     } else {
  414.         return $info(created)
  415.     }
  416.     }        
  417. }
  418.  
  419.  
  420. ## 
  421.  # -------------------------------------------------------------------------
  422.  #     
  423.  #    "file::createHeader" --
  424.  #    
  425.  #     Insert    a descriptive header into the current file.     Needs to be tailored 
  426.  #     more to different modes, but isn't    too    bad    right now.
  427.  #     
  428.  #     'forcemode' will force    the    file into that mode    via    emacs-like mode
  429.  #     entries on    the    top    line of    the    file. 
  430.  #     
  431.  #     'parent' gives    the    name of    a class    from which the generated file
  432.  #     descends (appropriate for C++,    [incr Tcl] for example).
  433.  # 
  434.  # -------------------------------------------------------------------------
  435.  ##
  436. proc file::createHeader { {template ""} {parent "" } } {
  437.     # Make sure the current project is compatible with this mode
  438.     file::coordinateProjectForMode
  439.     if {$parent == ""} {set parent "•parent•"}
  440.     if {$template == ""} { set template [list "" "" "Header" "\#" "" ""] }
  441.     # make the header
  442.     if {[lindex $template 1] != "Empty" } {
  443.     set t ""
  444.     set class [file::className]
  445.     if {$class == "Untitled"} {set class "•class name•"}
  446.     set file [win::CurrentTail]
  447.     set docHeadType [lindex $template 2]
  448.     if {$docHeadType != "None" } {
  449.         append t [file::topHeader]
  450.         if {$docHeadType != "Basic"} {
  451.         if {$docHeadType == "Source" || [file::isSource $file]} {
  452.             # it's a source file
  453.             append t " See header file for further information\r"
  454.         } elseif {$docHeadType == "Header" || $docHeadType == "*" && [file::isHeader $file]} {
  455.             global user
  456.             append t " Description: \r"
  457.             append t "\r"
  458.             append t " History\r"
  459.             append t "\r"
  460.             append t " modified by  rev reason\r"
  461.             append t " ---------- --- --- -----------\r"
  462.             append t " [file::paddedDate [file::created 0]] $user(author_initials) 1.0 original\r"
  463.         } else {
  464.             # not header or source or basic... oh well!
  465.         }
  466.         }
  467.         append t "###################################################################"
  468.         set t [file::commentTextBlock $t]
  469.         global mode
  470.         global ${mode}::firstHeaderLine
  471.         if {[info exists ${mode}::firstHeaderLine]} {
  472.         regsub "\r" $t "[quote::Regsub [set ${mode}::firstHeaderLine]]\r" t                
  473.         } else {
  474.         regsub "\r" $t "-*-${mode}-*-\r" t
  475.         }
  476.     }
  477.     set procName [lindex $template 3]
  478.     if {$procName != "\#" && [info commands $procName] == ""} { 
  479.         global PREFS
  480.         if [catch {uplevel \#0 source [list [file join $PREFS prefs.tcl]]}] {
  481.         alertnote "An error occurred while loading \"prefs.tcl\"" 
  482.         global errorInfo
  483.         dumpTraces "prefs.tcl error" $errorInfo
  484.         error ""
  485.         }            
  486.     }
  487.     if [catch {append t [eval $procName [list $class] [list $parent] [lindex $template 5]]}] {
  488.         alertnote "An error occurred while calling \"$procName\"" 
  489.         global errorInfo
  490.         dumpTraces "$procName error" $errorInfo
  491.         error ""
  492.     }
  493.     goto [minPos]
  494.     elec::Insertion $t
  495.     }
  496.     return ""
  497. }
  498.  
  499. ## 
  500.  # -------------------------------------------------------------------------
  501.  #     
  502.  #    "file::createDocument" --
  503.  #    
  504.  #     Make a new document from a given template type.
  505.  #     
  506.  #     'forcemode' will force    the    file into that mode    via    emacs-like mode
  507.  #     entries on    the    top    line of    the    file. 
  508.  #     
  509.  # -------------------------------------------------------------------------
  510.  ##
  511. proc file::createDocument { {winCreate ""} {forcemode "" } } {
  512.     # pick a template
  513.     # if [fileIsHeader    $file]
  514.     global elec::DocTemplates mode DocprojmodeVars
  515.     # decide if its mode-specific or not
  516.     set f [lindex $winCreate 2]
  517.     if $DocprojmodeVars(docTemplatesModeSpecific) {
  518.     if {$forcemode != ""} {
  519.         set tlist [file::docTemplates $f $forcemode non]
  520.     } else {
  521.         set tlist [file::docTemplates $f $mode non]
  522.     }
  523.     } else {
  524.     set tlist [file::docTemplates $f "" non]
  525.     }
  526.     lappend tlist "<Create new document type>"
  527.     if {$non != ""} {
  528.     eval lappend tlist "----------------------------------------------------" [lsort $non]
  529.     }
  530.     set tchoice [listpick -p "Pick a document template to insert" -L "Default" $tlist]
  531.     if {$tchoice == "<Create new document type>"} {
  532.     set tchoice [file::newDocumentTemplate 1]
  533.     }
  534.     if {$tchoice == "----------------------------------------------------"} { error "" }
  535.     
  536.     set tinfo [file::docTemplateInfo $tchoice]
  537.     set subTypes [lindex $tinfo 5]
  538.     if {$subTypes != ""} {
  539.     # replace the list of options with just the one selected
  540.     set tinfo [lreplace $tinfo 5 5 [listpick -p "Pick a document subtype of $tchoice" $subTypes]]
  541.     }
  542.     if {$forcemode == "" && [lindex $tinfo 0] != "*"} {
  543.     set forcemode [lindex $tinfo 0]
  544.     }
  545.     if {$winCreate != ""} {
  546.     eval $winCreate
  547.     }
  548.     
  549.     if { $forcemode != "" && $mode != $forcemode} { 
  550.     changeMode $forcemode
  551.     }
  552.     # we need to do this to stop modes switching later if this file isn't
  553.     # obviously a '$mode' file.
  554.     global win::Modes
  555.     set win::Modes($f) $mode
  556.     # set the project
  557.     Docproj::changeProject [lindex $tinfo 4]
  558.     # if the current project doesn't like this mode, then switch
  559.     file::coordinateProjectForMode
  560.     return $tinfo
  561. }
  562.  
  563. proc file::docTemplates { {f ""} {modeSpecific ""} {other ""}} {
  564.     global elec::DocTemplates
  565.     if {$other != ""} { upvar $other noList }
  566.     set tlist ""
  567.     set noList ""
  568.     if {$f != "" && $f != "Untitled"} {
  569.     set m [file::whichModeForWin $f]
  570.     foreach t ${elec::DocTemplates} {
  571.         if [file::docTemplateMatchExt $t $f $m] {
  572.         lappend tlist [lindex $t 1]
  573.         } else {
  574.         lappend noList [lindex $t 1]
  575.         }
  576.     }        
  577.     } else {
  578.     foreach t ${elec::DocTemplates} {
  579.         if {$modeSpecific == "" || [string match [lindex $t 0] $modeSpecific]} {
  580.         lappend tlist [lindex $t 1]
  581.         } else {
  582.         lappend noList [lindex $t 1]
  583.         }
  584.     }        
  585.     }    
  586.     return [lsort $tlist]
  587. }
  588.  
  589. proc file::docTemplateMatchExt {t f {m ""}} {
  590.     if {$m == ""} {set m [file::whichModeForWin $f]}
  591.     # match everything to a file with no particular extension
  592.     if {$m == "Text"} { return 1 }
  593.     set l [lindex $t 0]
  594.     set mMatch [expr [lsearch -exact $l $m] != -1]
  595.     switch [lindex $t 2] {
  596.     "None" -
  597.     "Basic" -
  598.     "*" {
  599.         if {$l == "*"} {
  600.         return 1
  601.         } else {
  602.         return $mMatch
  603.         }
  604.     }
  605.     "Header" {
  606.         if {$mMatch} {
  607.         return [file::isHeader $f $m]
  608.         }
  609.     }
  610.     "Source" {
  611.         if {$mMatch} {
  612.         return [file::isSource $f $m]
  613.         }
  614.         
  615.     }
  616.     }
  617.     return 0
  618. }
  619.  
  620. proc file::docTemplateInfo {name} {
  621.     global elec::DocTemplates
  622.     foreach t ${elec::DocTemplates} {
  623.     if {$name == [lindex $t 1]} {
  624.         return $t
  625.     }
  626.     }
  627. }
  628. proc file::docTemplateIndex {name} {
  629.     set i 0
  630.     global elec::DocTemplates
  631.     foreach t ${elec::DocTemplates} {
  632.     if {$name == [lindex $t 1]} {
  633.         return $i
  634.     }
  635.     incr i
  636.     }
  637. }
  638.  
  639. proc file::notTextMode {} {
  640.     global mode mode::features
  641.     if { $mode == "Text" } {
  642.     # we probably don't want Text mode     
  643.     set m [listpick -p "Pick a mode:" -L "Text" [array names mode::features]]
  644.     if { $m == "" } {set m "Text"}
  645.     changeMode $m
  646.     } 
  647. }
  648.  
  649. ## 
  650.  # -------------------------------------------------------------------------
  651.  #     
  652.  #    "file::topHeader"    --
  653.  #    
  654.  #     Inserts the top part of a    descriptive    header into    the    current    file
  655.  # -------------------------------------------------------------------------
  656.  ##
  657. proc file::topHeader { } {
  658.     global user
  659.     set file [win::CurrentTail]
  660.     if [catch {getFileInfo [win::Current] info}] {
  661.     set created [mtime [now]]
  662.     set last_update $created
  663.     } else {
  664.     set created [mtime $info(created)]
  665.     set last_update [mtime $info(modified)]
  666.     }        
  667.     append t "###################################################################\r"
  668.     if {[file::projectName] != "*"} {
  669.     append t " [file::projectName] - [file::projectAddendum]\r"
  670.     }
  671.     append t "\r" 
  672.     append t " FILE: \"" $file "\"\r"
  673.     append t "                                   created: $created \r"
  674.     append t "                               last update: $last_update \r"    
  675.     append t " Author: $user(author)\r"
  676.     append t " E-mail: $user(email)\r"
  677.     if {$user(organisation) != ""} {
  678.     append t "   mail: $user(organisation)\r"
  679.     }
  680.     if {$user(address) != ""} {
  681.     append t "         $user(address)\r"
  682.     }
  683.     if {$user(www) != ""} {
  684.     append t "    www: $user(www)\r"
  685.     }
  686.     append t " \r"
  687.     append t [file::[file::projectLicense]]
  688.     if {[set e [file::projectExtra]] != ""} {
  689.     append t "[breakIntoLines $e]\r \r"
  690.     }
  691.     return $t
  692. }
  693.  
  694. ## 
  695.  # -------------------------------------------------------------------------
  696.  #     
  697.  #    "file::className"    --
  698.  #    
  699.  #     Extract root of file name as a    class name for the file    (obviously most    
  700.  #     relevant to C++)  
  701.  # -------------------------------------------------------------------------
  702.  ##
  703. proc file::className {} { return [file::baseName [win::CurrentTail]] }
  704.  
  705.  
  706. ## 
  707.  # -------------------------------------------------------------------------
  708.  #   
  709.  #  "file::coordinateProjectForMode" --
  710.  #  
  711.  #   When we create a new file or header automatically, it contains
  712.  #   information about our current project (as defined in docProject(...)).
  713.  #   Unfortunately we often forget to select the correct project first.
  714.  #   This procedure makes sure that your project is compatible with the
  715.  #   current mode, given the information in the 'docProject' array. If it isn't
  716.  #   then the current project is changed if a better match can be found. 
  717.  #         
  718.  #  Results:
  719.  #   None
  720.  #  
  721.  #  Side effects:
  722.  #   The current project may be changed
  723.  # -------------------------------------------------------------------------
  724.  ##
  725. proc file::coordinateProjectForMode {} {
  726.     global mode docProject
  727.     set currProj [file::projectName]
  728.     set projModes [lindex $docProject(default_modes) \
  729.       [lsearch -exact $docProject(name) [file::projectName]]]
  730.     if { $projModes != "" && [lsearch -exact $projModes $mode] == -1 } {
  731.     # this project doesn't like this mode.
  732.     # see if there's a better one
  733.     foreach modeLists $docProject(default_modes) {
  734.         if { [lsearch -exact $modeLists $mode] != -1 } {
  735.         # found a fit
  736.         set index [lsearch -exact $docProject(default_modes) $modeLists]
  737.         set proj [lindex $docProject(name) $index]
  738.         Docproj::changeProject "$proj"
  739.         return
  740.         }
  741.     }
  742.     }
  743. }
  744.  
  745. proc file::createNewClass {} {
  746.     global mode
  747.     # if the current project doesn't like this mode, then switch
  748.     file::coordinateProjectForMode
  749.     beep
  750.     set class [statusPrompt "A name for the new class:"]
  751.     set parent [statusPrompt "Descended from:" ]
  752.     switch $mode {
  753.     "C" -
  754.     "C++" {
  755.         file::createHeader [file::createDocument "new -n ${class}.cc" C++] $parent
  756.         file::createHeader [file::createDocument "new -n ${class}.h" C++] $parent
  757.     } 
  758.     "Tcl" {
  759.         file::createHeader [file::createDocument "new -n ${class}.tcl" Tcl] $parent
  760.     }
  761.     default {
  762.         message "No class procedure defined for your mode. Why not write one yourself?"
  763.     }
  764.     
  765.     }            
  766.     
  767. }
  768.  
  769.  
  770. ## 
  771.  # -------------------------------------------------------------------------
  772.  #   
  773.  # "file::updateGeneralDate" --
  774.  #  
  775.  #  Updates the date in the header of a file.  Normally this is the 
  776.  #  'last update' date, but we can override that if desired.
  777.  # -------------------------------------------------------------------------
  778.  ##
  779. proc file::updateGeneralDate { name {patt ""} {time ""}} {
  780.     if {$patt == ""} {set patt {last update: }}
  781.     regsub -all { } $patt "\[ \t\]" spatt
  782.     set pos [getPos]
  783.     set end [selEnd]
  784.     set hour {[0-9][0-9]?(:|\.)[0-9][0-9]((:|\.)[0-9][0-9])?([ \t][APap][Mm])?}
  785.     set date {[0-9][0-9]?(/|\.|\-)[0-9][0-9]?(/|\.|\-)[0-9][0-9]([0-9][0-9])?}
  786.     append spatt "\[ \t\]*" $date "\[ \t]\{?" $hour {\}?}
  787.     set datePos [search -s -n -f 1 -r 1 -m 0 -l [pos::math [minPos] + 1000] $spatt [minPos]]
  788.     if {![llength $datePos]} {return}
  789.     if {$time == ""} {set time [mtime [now] short]}
  790.     if {[eval getText $datePos] == $time} {return}
  791.     eval replaceText $datePos [list $patt $time]
  792.     select $pos $end
  793.     return
  794. }
  795.  
  796. proc file::updateDate { {name ""} } {
  797.     set fr [win::Current]
  798.     if { $name == "" } {
  799.     set name $fr
  800.     }
  801.     if { $name != $fr } {
  802.     bringToFront $name
  803.     file::updateGeneralDate $name
  804.     bringToFront $fr
  805.     } else {
  806.     file::updateGeneralDate $name
  807.     }    
  808. }
  809.  
  810. proc file::updateCreationDate { name } {
  811.     if [catch {getFileInfo [stripNameCount [win::Current]] info}] {
  812.     set created [mtime [now]]
  813.     } else {
  814.     set created [mtime $info(created)]
  815.     }        
  816.     file::updateGeneralDate $name "created" $created
  817. }
  818.  
  819. proc file::newFunction {} {
  820.     elec::Insertion "[file::className]::•name•(•args•){\r\t•body•\r}\r"
  821. }
  822.  
  823. proc global::newDocumentTemplate { {subCall 0} } {
  824.     set newT [global::_editDocumentTemplate]
  825.     global elec::DocTemplates 
  826.     lappend elec::DocTemplates $newT
  827.     # save it permanently
  828.     global modifiedVars
  829.     lappend modifiedVars elec::DocTemplates
  830.     # add template to "prefs.tcl"
  831.     set procedure [lindex $newT 3]
  832.     set subproj [lindex $newT 5]
  833.     if {$procedure != "\#"} {
  834.     set def [file::_getDefault "Do you want to use this as the template?" t]
  835.     set t "\r"
  836.     append t "proc $procedure \{docname parentdoc"
  837.     if {$subproj != ""} { append t " subtype " }
  838.     append t "\} \{\r"
  839.     append t "\t# You must fill this in\r"
  840.     if {$subproj != ""} { append t "\t# Possible 'subtypes' are: $subproj\r" }
  841.     append t $def
  842.     append t "\r\treturn \$t\r\}\r"
  843.     addUserLine $t
  844.     if {[askyesno "I've added a template for the procedure to your 'prefs.tcl'. Do you want to edit it now?"] == "yes"} {
  845.         global::editPrefsFile
  846.         goto [maxPos]
  847.         if $subCall { 
  848.         alertnote "Once you've finished editing, hit cmd-N to go back and create a new document." 
  849.         # so our calling proc stops
  850.         error "Editing"
  851.         }
  852.     }
  853.     }
  854.     return [lindex $newT 1]
  855. }
  856.  
  857. proc file::_varValue {var} {
  858.     upvar $var a
  859.     if [info exists a] {
  860.     return $a
  861.     } else {
  862.     return ""
  863.     }
  864. }
  865.  
  866. proc file::_getDefault { text {default ""} {var ""}} {
  867.     if {[isSelection]} {
  868.     if {[askyesno "I notice you've selected some text. $text"] == "yes"} {
  869.         set default [getSelect]
  870.     } 
  871.     }
  872.     if {$default == ""} {
  873.     set default [getline "Enter template text (you can edit it later)" $default]
  874.     }
  875.     if {$var != ""} {
  876.     return [elec::_MakeIntoInsertion $default $var]
  877.     } else {
  878.     return $default
  879.     }
  880. }
  881.  
  882. proc global::_editDocumentTemplate {{def ""}} {
  883.     global DocprojmodeVars
  884.     if {$def == ""} {
  885.     set title "Create a new document template" 
  886.     set def {"" "" "By File Extension" "t_XXX" $DocprojmodeVars(currentProject) ""}
  887.     set new 1
  888.     } else {
  889.     set title "Edit document template" 
  890.     set new 0
  891.     }
  892.     
  893.     global docProject
  894.     set name ""
  895.     while { $name == ""} {
  896.     set y 40
  897.     set yb 220
  898.     set res [eval dialog -w 380 -h 340 \
  899.       [dialog::title $title 380] \
  900.       [dialog::button "OK" 290 yb] \
  901.       [dialog::button "Cancel" 290 yb] \
  902.       [dialog::textedit "Descriptive Name" [lindex $def 1] 10 y 15] \
  903.       [dialog::textedit "Modes (blank = all)" [lindex $def 0] 10 y 15] \
  904.       [dialog::textedit "Procedure name" [lindex $def 3] 10 y 15] \
  905.       [dialog::text "Descriptive header for this document template" 10 y] \
  906.       [dialog::text "(if 'Source', or 'Header', the mode must define" 10 y] \
  907.       [dialog::text "headerSuffices and sourceSuffices vars)" 10 y] \
  908.       [dialog::menu 10 y [list "None" "-" "Basic" "Source" "Header" "Either"] [lindex $def 2]] \
  909.       [dialog::text "Project name" 10 y] \
  910.       [dialog::menu 10 y $docProject(name) [lindex $def 4]] \
  911.       [dialog::textedit "List of sub-types" [lindex $def 5] 10 y 30] \
  912.       ]
  913.     if [lindex $res 1] { error "Cancel" } 
  914.     set i 1
  915.     foreach var {name modes procedure filetype proj subproj} {
  916.         set $var [lindex $res [incr i]]
  917.     }
  918.     if {$name == ""} { beep ; message "You must enter a name." }
  919.     }    
  920.     if {$modes == ""} {set modes "*"}
  921.     if {$filetype == "Either"} {set filetype "*"}
  922.     if {$proj == "None"} {set proj "*"}
  923.     if {$procedure == ""} {set procedure "\#"}
  924.     return [list $modes $name $filetype $procedure $proj $subproj]
  925.     
  926. }
  927.  
  928. proc global::editDocumentTemplate {} {
  929.     global modifiedVars elec::DocTemplates
  930.     set tlist [file::docTemplates] 
  931.     set l [listpick -p "Which document template do you want to edit?" $tlist]
  932.     set lind [file::docTemplateIndex $l]
  933.     set l [global::_editDocumentTemplate [file::docTemplateInfo $l]]
  934.     set elec::DocTemplates [lreplace ${elec::DocTemplates} $lind $lind $l]
  935.     lappend modifiedVars elec::DocTemplates
  936. }
  937.  
  938. proc global::removeDocumentTemplate {} {
  939.     global modifiedVars elec::DocTemplates
  940.     set tlist [file::docTemplates] 
  941.     set l [listpick -p "Which document template shall I permanently remove?" $tlist]
  942.     set l [file::docTemplateIndex $l]
  943.     set elec::DocTemplates [lreplace ${elec::DocTemplates} $l $l]
  944.     lappend modifiedVars elec::DocTemplates
  945. }
  946.  
  947. ## Create this sort of stuff.
  948.  # set docProject(name) [list    "None" "EvoX" "Vince's Additions" "Cpptcl"]
  949.  # set docProject(addendum) {    {none} {evolution in complex systems} \
  950.  #       {an extension package for Alpha}    {connecting    C++    with Tcl} }
  951.  # set docProject(default_modes) { {}    {C C++}    {Tcl} {C C++ Tcl}}
  952.  ##
  953. proc global::newProject {} {
  954.     global docProject
  955.     set res [global::_editProject]
  956.     set i -1
  957.     foreach var {name addendum license extra default_modes} {
  958.     lappend docProject($var) [lindex $res [incr i]]
  959.     }
  960.     global modifiedArrVars
  961.     lappend modifiedArrVars docProject
  962.     addMenuItem -m {Current Project} [lindex $res 0]
  963.     Docproj::changeProject [lindex $res 0]
  964. }
  965. proc global::_editProject {{def ""}} {
  966.     if {$def == ""} {
  967.     set title "Create a new project"
  968.     set def [list "Vince's Additions" \
  969.       "an extension package for Alpha" "seeFileLicenseTerms" \
  970.       "See the file \"license.terms\" for information on usage and redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES." ""]
  971.     } else {
  972.     set title "Edit a project"
  973.     }
  974.     set y 40
  975.     set yb 270
  976.     global elec::LicenseTemplates
  977.     set res [eval dialog -w 380 -h 325 \
  978.       [dialog::title $title 360] \
  979.       [dialog::button "OK" 290 yb] \
  980.       [dialog::button "Cancel" 290 yb] \
  981.       [dialog::textedit "Short Descriptive Name" [lindex $def 0] 10 y 15] \
  982.       [dialog::textedit "Longer Description to append to the above" [lindex $def 1] 10 y 25] \
  983.       [dialog::text "License type for header comments" 10 y] \
  984.       [dialog::menu 10 y ${elec::LicenseTemplates} [lindex $def 2]] \
  985.       [dialog::textedit "Additional text for end of header comments" [lindex $def 3] 10 y 35 5] \
  986.       [dialog::textedit "Modes (blank = all)" [lindex $def 4] 10 y 15] \
  987.       ]
  988.     if [lindex $res 1] { error "Cancel" }
  989.     return [lrange $res 2 6]    
  990. }
  991.  
  992. proc global::editProject {} {
  993.     global docProject modifiedArrVars
  994.     set l [listpick -p "Which project do you wish to edit?" \
  995.       -L [file::projectName] $docProject(name)]
  996.     set item [lsearch -exact $docProject(name) $l]
  997.     foreach uvar {name addendum license extra default_modes} {
  998.     lappend def [lindex $docProject($uvar) $item]
  999.     }
  1000.     set def [global::_editProject $def]
  1001.     set i -1
  1002.     foreach uvar {name addendum license extra default_modes} {
  1003.     set docProject($uvar) [lreplace $docProject($uvar) $item $item [lindex $def [incr i]]]
  1004.     }
  1005.     lappend modifiedArrVars docProject
  1006. }
  1007.  
  1008. proc global::removeProject {} {
  1009.     global docProject modifiedArrVars
  1010.     set l [listpick -p "Which project shall I permanently remove?" $docProject(name)]
  1011.     set item [lsearch -exact $docProject(name) $l]
  1012.     foreach uvar {name addendum license extra default_modes} {
  1013.     set docProject($uvar) [lreplace $docProject($uvar) $item $item]
  1014.     }
  1015.     lappend modifiedArrVars docProject
  1016.     if {[file::projectName] == $l} {
  1017.     Docproj::changeProject "None"
  1018.     }
  1019.     deleteMenuItem -m {Current Project} $l
  1020. }
  1021.  
  1022.  
  1023.  
  1024.  
  1025.  
  1026.  
  1027.  
  1028.  
  1029.  
  1030.  
  1031.